Code and Notes (Week 4 Thursday)

module PracWeek4 where
import Test.QuickCheck
import Data.List (sort, nub)

isAssoc :: (Float -> Float -> Float) -> Float -> Float -> Float -> Bool
isAssoc op x y z =
  (x `op` y) `op` z == x `op` (y `op` z)

-- load this up and try running:
--    quickCheck $ isAssoc (+)

isSymm :: (Float -> Float -> Float) -> Float -> Float -> Bool
isSymm op x y =
    x `op` y == y `op` x



-- binary search stuff

binarySearch1 :: Ord a => a -> [a] -> Maybe Int
binarySearch1 _ [] = Nothing
binarySearch1 x xs =
  let
    mid = length xs `div` 2
    (ys,z:zs) = splitAt mid xs
  in
    case compare x z of
      EQ -> Just mid
      LT -> binarySearch1 x ys
      GT -> case binarySearch1 x zs of
              Nothing -> Nothing
              Just n -> Just(n+mid)

binarySearch2 :: Ord a => a -> [a] -> Maybe Int
binarySearch2 _ [] = Nothing
binarySearch2 x xs =
  let
    mid = length xs `div` 2
    (ys,z:zs) = splitAt mid xs
  in
    case compare x z of
      EQ -> Just mid
      LT -> binarySearch2 x ys
      GT -> case binarySearch2 x zs of
              Nothing -> Nothing
              Just n -> Just(n+mid+1)


type SearchAlgorithm a = a -> [a] -> Maybe Int

binsProp :: Ord a => SearchAlgorithm a -> a -> [a] -> Bool
binsProp alg x xs =
  case alg x xs of
    Nothing -> not(x `elem` xs)
    Just n  -> xs !! n == x

sorted :: Ord a => [a] -> Bool
sorted (a:b:cs) = a <= b && sorted (b:cs)
sorted _ = True

binsProp2 :: Ord a => SearchAlgorithm a -> a -> [a] -> Property
binsProp2 alg x xs =
  sorted xs ==>
  case alg x xs of
    Nothing -> not(x `elem` xs)
    Just n  -> xs !! n == x

binsProp3 :: Ord a => SearchAlgorithm a -> a -> [a] -> Bool
binsProp3 alg x xs' =
  let xs = sort xs' in
  case alg x xs of
    Nothing -> not(x `elem` xs)
    Just n  -> xs !! n == x


newtype MySortedList a = MySortedList [a] deriving (Eq, Show)

instance (Arbitrary a, Ord a) => Arbitrary (MySortedList a) where
    arbitrary = MySortedList . sort . nub <$> arbitrary


binsProp4 :: Ord a => SearchAlgorithm a -> a -> MySortedList a -> Bool
binsProp4 alg x (MySortedList xs) =
  case alg x xs of
    Nothing -> not(x `elem` xs)
    Just n  -> xs !! n == x

-- checking for totality

hasValue :: (a -> b -> c) -> a -> b -> Bool
hasValue op x y =
  seq (x `op` y) True

-- quickCheck $ hasValue div


-- playing around in assignment one

{- 
newtype TreeList = TreeList [String] deriving (Eq, Show)

instance Arbitrary TreeList where
    arbitrary = TreeList . toList <$> (genTrie 4)

printProp :: TreeList -> Bool
printProp t = True
-}